home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 9 / Night Owl CD-ROM (NOPV9) (Night Owl Publisher) (1993).ISO / 012a / lib194.zip / COLOR.PRG < prev    next >
Text File  |  1992-12-23  |  8KB  |  211 lines
  1. *-------------------------------------------------------------------------------
  2. *-- Program...: COLOR.PRG
  3. *-- Programmer: Ken Mayer (CIS: 71333,1030)
  4. *-- Date......: 06/25/1992
  5. *-- Notes.....: These routines are color processing routines that are not
  6. *--             in the main procedure file. See README.TXT for details on how
  7. *--             to use this library file.
  8. *-------------------------------------------------------------------------------
  9.  
  10. FUNCTION ColorOf
  11. *-------------------------------------------------------------------------------
  12. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  13. *-- Date........: 01/11/1992
  14. *-- Notes.......: This function will return the color of a specified area
  15. *--               (as built in to dBASE). 
  16. *-- Written for.: dBASE IV, 1.1
  17. *-- Rev. History: None
  18. *-- Calls.......: ALLTRIM()            Function in PROC.PRG
  19. *-- Called by...: Any
  20. *-- Usage.......: ColorOf("<cArea>")
  21. *-- Example.....: ?ColorOf("Messages")
  22. *-- Returns.....: Color (foreground/background)
  23. *-- Parameters..: cArea = Area you wish to return the color of from list:
  24. *--               BOX/BOXES        = Boxes
  25. *--               BORDER/PERIMETER = Border color
  26. *--               NORMAL           = Normal screen/text
  27. *--               HIGHLIGHT        = Highlights
  28. *--               MESSAGE          = Messages
  29. *--               TITLE            = Titles
  30. *--               INFORMATION      = Information
  31. *--               FIELDS           = Fields
  32. *-------------------------------------------------------------------------------
  33.  
  34.     parameters cArea
  35.     
  36.     private cAttrib, cWanted, nPos
  37.     
  38.     cAttrib = set("ATTRIBUTES")
  39.     cWanted = upper(alltrim(cArea))
  40.     
  41.     if cWanted = "BOX"
  42.         nPos = 6
  43.     else
  44.         nPos = at(left(cWanted,4),;
  45.             "    NORM HIGH PERI MESS TITL BOXE INFO FIEL BORD") / 5
  46.         if nPos = 9
  47.             nPos = 3    && "Border" = "Perimeter"
  48.         endif
  49.     endif
  50.     
  51.     do case
  52.         case nPos = 0
  53.             cAttrib = ""  && return null string for error
  54.         case nPos < 4
  55.             cAttrib = left(cAttrib,at("&",cAttrib) - 2)
  56.         otherwise
  57.             cAttrib = substr(cAttrib,at("&",cAttrib) + 3)
  58.             nPos = nPos - 3
  59.     endcase
  60.     do while nPos > 1
  61.         cAttrib = substr(cAttrib,at(",",cAttrib) + 1)
  62.         nPos = nPos - 1
  63.     enddo
  64.     
  65. RETURN left(cAttrib,at(",",cAttrib+",")-1)
  66. *-- EoF: ColorOf()
  67.  
  68. FUNCTION Attribyte
  69. *-------------------------------------------------------------------------------
  70. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  71. *-- Date........: 03/19/1992
  72. *-- Notes.......: Converts a dBASE color code for an area to the corresponding
  73. *--               attribute byte as it is stored in video RAM.
  74. *--               Does not work for monochrome codes and does not check for
  75. *--               validity of color code given.
  76. *-- Written for.: dBASE IV, 1.1
  77. *-- Rev. History: None
  78. *-- Calls.......: None
  79. *-- Called by...: Any
  80. *-- Usage.......: Attribyte(<cCode>)
  81. *-- Example.....: ? Attribyte("BG+/B")
  82. *-- Returns.....: Numeric = Attribute byte value, in example 27 (0001 1011b)
  83. *-- Parameters..: cCode = dBase code for colors of an area
  84. *-------------------------------------------------------------------------------
  85.  
  86.     parameters cCode
  87.     private nAttr,cHalf,nSlash
  88.     nSlash=at("/",cCode)
  89.     cHalf=trim(ltrim(iif(nSlash=0,"N",substr(cCode,nSlash+1))))
  90.     nAttr=16*(iif("B" $ cHalf,1,0)+iif("G" $ cHalf,2,0);
  91.       +iif("R" $ cHalf,4,0)+iif("W" $ cHalf,7,0))
  92.     cHalf=trim(ltrim(iif(nSlash=0,cCode,left(cCode,nSlash-1))))
  93.     nAttr=nAttr+iif("B" $ cHalf,1,0)+iif("G" $ cHalf,2,0);
  94.       +iif("R" $ cHalf,4,0)+iif("W" $ cHalf,7,0)
  95.     nAttr=nAttr+iif("+" $ cCode,8,0)+iif("*" $ cCode,128,0)
  96.     
  97. RETURN iif("X" $ cCode, 0, nAttr)
  98. *-- EoF: Attribyte()
  99.  
  100. FUNCTION Colorname
  101. *-------------------------------------------------------------------------------
  102. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  103. *-- Date........: 03/19/1992
  104. *-- Notes.......: Converts an attribute value for an area to the name of the
  105. *--               corresponding color combination, assuming Iscolor() = .T.
  106. *--               Does not check for validity of argument, integer 0<=arg<256
  107. *-- Written for.: dBASE IV, 1.1
  108. *-- Rev. History: None
  109. *-- Calls.......: None
  110. *-- Called by...: Any
  111. *-- Usage.......: Colorname(<nAttr>)
  112. *-- Example.....: ? Colorname(27)
  113. *-- Returns.....: Character = Name of color combination, in example
  114. *--                    "bright cyan on blue"
  115. *-- Parameters..: nAttr = value of attribute byte
  116. *-------------------------------------------------------------------------------
  117.  
  118.     parameters nAttr
  119.     private nColr,cName
  120.     cName=iif(nAttr>127,"blinking ","")
  121.     nColr=mod(nAttr,16)
  122.     do case
  123.       case nColr=8
  124.         cName=cName+"gray"
  125.       case nColr=14
  126.         cName=cName+"yellow"
  127.       otherwise
  128.         if nColr>7
  129.           cName=cname+"bright "
  130.         endif
  131.         cName=cName+trim(substr("black  blue   green  cyan   ";
  132.           +"red    magentabrown  white  ",mod(nColr,8)*7+1,7))
  133.     endcase
  134.     nColr = mod(int(nAttr/16),8)
  135.     cName=cName+" on "+trim(substr("black  blue   green  cyan   ";
  136.       +"red    magentabrown  white  ",nColr*7+1,7))
  137.     
  138. RETURN cName
  139. *-- EoF: Colorname()
  140.  
  141. FUNCTION Colorcode
  142. *-------------------------------------------------------------------------------
  143. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  144. *-- Date........: 03/19/1992
  145. *-- Notes.......: Converts an attribute value for an area to the dBase code for
  146. *--               the corresponding color combination, assuming Iscolor() = .T.
  147. *--               Does not check for validity of argument, integer 0<=arg<256
  148. *-- Written for.: dBASE IV, 1.1
  149. *-- Rev. History: None
  150. *-- Calls.......: None
  151. *-- Called by...: Any
  152. *-- Usage.......: Colorcode(<nAttr>)
  153. *-- Example.....: ? Colorcode(27)
  154. *-- Returns.....: Character = Code for color combination, in example "BG+/B"
  155. *-- Parameters..: nAttr = value of attribute byte
  156. *-------------------------------------------------------------------------------
  157.  
  158.     parameters nAttr
  159.     private cColrs
  160.     cColrs="N B G BGR RBGRW "
  161.     
  162. RETURN trim(substr(cColrs,mod(nAttr,8)*2+1,2));
  163.   +iif(mod(int(nAttr/8),2)>0,"+","");
  164.   +iif(nAttr>127,"*","")+"/";
  165.   +trim(substr(cColrs,mod(int(nAttr/16),8)*2+1,2))
  166. *-- EoF: Colorcode()
  167.  
  168. PROCEDURE ReColor
  169. *-------------------------------------------------------------------------------
  170. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  171. *-- Date........: 04/23/1992
  172. *-- Notes.......: Restores colors to those held in a string of the form
  173. *--               returned by set("ATTRIBUTE").
  174. *-- Written for.: dBASE IV, Versions 1.0 - 1.5.
  175. *-- Rev. History: None
  176. *-- Calls       : None
  177. *-- Called by...: Any
  178. *-- Usage.......: DO ReColor WITH <cColors>
  179. *-- Example.....: DO Recolor WITH OldColors
  180. *-- Parameters..: cColors, a string in the form returned by set("ATTRIBUTE").
  181. *-- Side effects: Changes the screen colors.
  182. *-------------------------------------------------------------------------------
  183.  
  184.   parameters cColors
  185.   private cThis, cNext, nAt, cLeft, nX, cAreas
  186.   cAreas = "   NORMHIGHBORDMESSTITLBOX INFOFIEL"
  187.   cLeft = cColors + ", "
  188.   nX = 0
  189.   do while nX < 8
  190.     nX = nX + 1
  191.     cThis = substr( cAreas, 4 * nX, 4 )
  192.     if nX = 3
  193.       nAt = at( "&", cLeft )
  194.       cNext = left( cLeft, nAt - 2 )
  195.       cLeft = substr( cLeft, nAt + 3 )
  196.       SET COLOR TO , , &cNext
  197.     else
  198.       nAt = at( ",", cLeft )
  199.       cNext = left( cLeft, nAt - 1 )
  200.       cLeft = substr( cLeft, nAt + 1 )
  201.       SET COLOR OF &cThis TO &cNext
  202.     endif
  203.   enddo
  204.  
  205. RETURN
  206. *-- EoP: ReColor
  207.  
  208. *-------------------------------------------------------------------------------
  209. *-- EoP: COLOR.PRG
  210. *-------------------------------------------------------------------------------
  211.